Matka GPS blogi interaktiivsele kaartile: Norra rattamatk 2017

Ronimine meile meeldib! Ülo ja Intsu mõtisklevad möödunud päeva üle Håra lähedal laagris. Selja taga on kõigest natuke üle 60 km, aga 1260 tõusumeetrit. 17. juuli 2017.

Marsruut

Norra rattamatk alguse ja lõpuga Tallinnast, 2017-07-10 kuni 2017-07-21. Auto ja laevaga Tallinn–Stockholm–Geilo ja tagasi 10-11. ja 20-21. juuli. Ratastega Geilo–Voss ring 12-19. juuli. Rongiga Voss–Geilo.

Träkkimine

Jalgrattamarsruuti träkkisin Suunto Ambit 2 kellaga. Aku tööaja pikendamiseks kasutasin 10 s salvestusintervalle ja ‘OK’ GPS täpsussetingut, mis peaks tagama ~50 tunnise patarei kasutusaja. Pika salvestusintervalli tõttu ei jookse GPS rada kaartile panduna alati täpselt mööda teid, vaid kipub kurve sirgeks lõikama, mis on muidugi minoorne puudus.

Proovime selle marsruudi päevade kaupa kokku panna ja kaartile joonistada koos kõrgusprofiiliga.

GPS rada kaartile

Tegelikult piisab selleks mõnest koodireast, kui kasutada R pakette leaflet ja leaflet.extras. Kõige pealt laadin Suunto Movescount võrgulehelt alla .gpx track failid ja salvestan nad oma arvutisse kataloogi nimega data/.

GPX failidest saab importida R-i GPS andmed GIS formaati näiteks kasutades readOGR funktsiooni paketist rgdal. Imporditud rajajooned/rajapunktid on Spatial klassi objektid, mida saab siis R-is edasi töödelda ja analüüsida kasutades näiteks sp või rgdal paketi tööriistu.

Mina kavatsen aga kasutada otse GPX andmete lisamiseks leaflet kaartile leaflet.extras paketi funktsiooni addGPX, mis võtab andmed kas a) gpx failist või b) gpx xml stringist (pikk xml formaadis lause). Niimoodi saan ma kasutada algseid andmeid ja jääb ära andmete vahepealne konverteerimine SpatialLines, SpatialPointsDataFrame või muusse sellisesse objekti.

Kui on soov eri failides olevaid radasid ühendada

Mõnel päeval salvestasin ma mitu träkki: näiteks enne lõunapausi ja peale lõunapausi. Liidan need träkid päevakaupa kokku. Selleks kasutan käsurea programmi gpsbabel, mille käivitamise ma pakendan R-i funktsiooni merge_gpx.

# Extract date from file name
extract_date <- function(gpxfile){
  # Remove letters and punctuation from file name
  datetime <- gsub("[a-zA-Z[:punct:]]", "", gpxfile)
  # Parse datetime
  datetime <- lubridate::ymd_hms(datetime)
  # Extract date
  date <- lubridate::date(datetime)
  as.character(date)
}

# Join/merge GPX files
merge_gpx <- function(gpxfiles, writetofile = TRUE, pathtosave = "./", activity = "Cycling") {
  
  # Input files
  input <- paste("-i gpx -f", gpxfiles, collapse = " ")
  
  # Writes to stdout
  output <- "-"
  
  # Write to file
  if(writetofile){
    # Create date id from unique dates
    date_id <- vapply(gpxfiles, extract_date, character(1))
    date_id <- paste0(unique(date_id), collapse = "_")
    # Output file name with path
    output <- file.path(pathtosave, sprintf("Merged_%s_%s.gpx", date_id, activity))
  }
  
  # Compose gpsbabel command
  gpsbabel_cmd <- sprintf("gpsbabel -t %s -x track,merge,title='COMBINED LOG' -o gpx -F %s", input, output)
  
  # Do merging and output merged file name or gpx string of merged tracks
  gpxstring <- system(gpsbabel_cmd, intern = !writetofile, ignore.stderr = TRUE)
  
  # Parse output
  if(!writetofile){
    # Returns xml as character vector, collapse rows into single string
    gpxstring <- paste(gpxstring, collapse = "")
  } else {
    # Returns file name of merged data
    message(sprintf("Writing merged gpx track to %s", output))
    gpxstring <- output
  }
  
  return(gpxstring)
}

Alustuseks moodustan gpx faili nimedest ja nende nimes olevatest kuupäevadest data_frame-i. Seejärel grupeerin failinimed kuupäevade järgi listidesse ja ühendan omavahel otsapidi iga kuupäeva päevateekonnad kasutades gpsbabel programmi. Viimaks lisan legendi jaoks tabelisse ka ‘käsitsi’ kokku pandud päevateekondade algus- ja lõpppunktid.

# List gpx files in data folder
gpx_files <- list.files("data/", full.names = TRUE)
# Extract date from gpx file name
tracks <- data_frame(gpx_files) %>% 
  mutate(date = extract_date(gpx_files))
# Group gpx filenames by date and join days trips
tracks <- tracks %>% 
  group_by(date) %>% 
  do(gpxstring = merge_gpx(.$gpx_files, writetofile = F)) %>% 
  ungroup()

# Add manually start and end points for days trips to be used in legend
tracks$trip  <- c("Geilo-Nedra Grøndalsvatne (Rallarvegen)",
                  "Nedra Grøndalsvatne-Voss-Dalavegen",
                  "Dalavegen-Stanghelle-Bergen (train)-Lyseklostervegen",
                  "Lyseklostervegen-Buavågen",
                  "Buavågen-Saudavegen",
                  "Saudavegen-Sauda-Håra",
                  "Håra-Odda-Utne",
                  "Kvanndal-Voss")

Arvutame summaarse tõusu ja laskumise iga päeva kohta

Kasutades gpx kõrgusandmeid (ele) arvutame kui palju sai iga päev mäest ülesse ronitud ja kui palju alla lastud.

get_ascent_descent <- function(gpx){
  ele <- xml2::as_xml_document(gpx) %>% 
    xml2::xml_ns_strip() %>% 
    xml2::xml_find_all("//ele") %>% 
    xml2::xml_double()
  ele_diffs <- diff(ele)
  ascent <- ele_diffs[ele_diffs > 0] %>% sum()
  descent <- ele_diffs[ele_diffs < 0] %>% sum() %>% abs
  return(data_frame(ascent = ascent, descent = descent))
}

tracks <- mutate(tracks, climbs = map(gpxstring, ~ get_ascent_descent(.x) %>% mutate_all(round))) %>% unnest(climbs)
tracks_gat <- select(tracks, -gpxstring) %>% 
  gather(key, value, ascent, descent)
ggplot(tracks_gat, aes(paste(date, trip, sep = ", "), value, fill = key)) + 
  geom_bar(stat = 'identity', position = 'dodge') +
  coord_flip() + 
  ylab("Summed value, meters") +
  scale_fill_viridis(discrete = TRUE) +
  theme(axis.title.y = element_blank(),
        legend.title = element_blank(),
        legend.position = c(0.85, 0.94),
        legend.background = element_blank())

Summaarne päeva tõus ja laskumine.

Lisame kaartile fotod

Lisan tabelisse ka matka jooksul paar telefoniga tehtud tehtud fotot, millel on positsiooni info olemas. Positsiooneerimisinfo võtan fotode infost välja kasutades käsureaprogrammi exiftool, mille olen jälle pakendanud R-i funktsioonina: exif_location. Alternatiivselt võib ligikaudse positsioneerimise tuletada foto tegemise kellaajast. Fotod saab lisada leaflet-is markerite popup-idesse, milleks tuleb fotode pathid pakendada HTML-ina, minimaalselt näiteks <img src="path-to-photo/" /> ja anda funktsioonile pildi koordinaadid.

# Get list of photos
photos <- list.files("photos/", full.names = TRUE)
# Function to extract location info from exif data
exif_location <- function(path) {
  # Read GPS locaton using exiftool
  exif_cmd <- paste("exiftool -c '%.6f'", path, "| grep 'GPS Position'")  
  location <- system(exif_cmd, intern = TRUE, ignore.stderr = TRUE) # execute exiftool-command
  location <- stringr::str_extract_all(location, "[0-9]+\\.[0-9]+") %>%
    unlist %>% 
    vapply(as.numeric, FUN.VALUE =  double(1), USE.NAMES = FALSE) 
  
  if(length(location)!=2){
    warning("Location data not found!")
    location <- c(NA, NA)
  }
  
  names(location) <- c("lat","lon")
  location <- c(path = path, location)
  return(location)
}
# Extract gps data from exif
photos_location <- lapply(photos, exif_location)
# Munge location data
photos_location <- do.call(rbind, photos_location) %>% 
  as_tibble() %>% 
  filter(complete.cases(.)) %>% 
  mutate_at(c("lat","lon"), as.numeric)
# Create popup
photos_location <- mutate(photos_location, 
                          date = extract_date(path),
                          popup = sprintf("<img src='%s' style='height:252px;width:448px;' />
                                          <p>Foto: Taavi Päll</p>", path))
# Nest data necessary to display photo on map into data_frame
photos_location <- nest(photos_location, path, lat, lon, popup, .key = "popupdata")
# Join photos data to tracks
tracks <- left_join(tracks, photos_location)

Päevateekonnad

Plotime oma ettevalmistatud andmed kasutades paketti leaflet. Kaartikihte saab lisada funktsiooniga addTiles või addProviderTiles. Saadaolevaid kaarte näitavad käsud providers ja providers.details.

# Let's have a look at some map providers
sample(providers, 6)

## $Esri.WorldShadedRelief
## [1] "Esri.WorldShadedRelief"
## 
## $Thunderforest.Pioneer
## [1] "Thunderforest.Pioneer"
## 
## $Stamen.TopOSMFeatures
## [1] "Stamen.TopOSMFeatures"
## 
## $HERE.mapLabels
## [1] "HERE.mapLabels"
## 
## $HERE.normalDayGreyMobile
## [1] "HERE.normalDayGreyMobile"
## 
## $HERE.normalDayGrey
## [1] "HERE.normalDayGrey"

leaflet-i kaart koostatakse kiht-kihilt. Iga päeva distantsi kanname eraldi kaartile, lisame kõrgusprofiili, legendi ja fotod, kui need on olemas.

Kõrgusprofiili lisamiseks on leaflet javascript programmile olemas plugin L.control.elevation, mis pole aga R-i jaoks implementeeritud. Lisaks vajab see plugin (loomulikult!) kõrgusinfot, mis paistab minevat kaduma, kui kasutada leaflet.extras paketi funktsiooni addGPX (viimane kasutab leafleti omnivore pluginat, mis GPX andmete puhul kõrgusinfot ei impordi). See tähendab, et tuleb kasutada üht teist leaflet GPX pluginat, mis impordib ka altituudi: leaflet-gpx. Aga ka see plugin pole R-i jaoks implementeeritud. Lahenduseks on need pluginad javascripti kujul leafleti R funktsiooni lisada, nagu on näidatud siin: https://gist.github.com/jcheng5/c084a59717f18e947a17955007dc5f92, kasutades htmlwidgets::onRender funktsiooni. Soovitav on enne kontrollida veebibrauseris kas lisatav JS ka muidu töötab.

API keys

Mitmed kaartikihtide pakkujad nt. thunderforest tahavad registreerimist. Ilma registreerimiseta näidatakse kaartil tüütut vesimärki. Thunderforestil on väikeses mahus kasutamine tasuta ja registreerimisel antakse unikaalne API key, mis tuleb kaarti URL-i lõppu lisada kujul ?apikey=your-unique-apikey (vt. ka allpool olevat koodi). Et mitte oma isiklikku apikey-d tervele internetile avalikuks teha, tuleks see lisada R-i environment variable-ks, kust selle saab kätte kasutades käsku Sys.getenv(). Käimasolevasse R-i sessiooni environmenti saab apikey lisada kasutades Sys.setenv(THUNDERF_APIKEY = "your-unique-apikey") käsku (thunderforest-i näitel). Sellisel juhul läheb see R-ist väljumisel muidugi kaotsi ja tuleb taaskäivitamisel uuesti lisada. Permanentselt saab sellise apikey lisada oma R-i environmenti kirjutades selle rea (THUNDERF_APIKEY = “your-unique-apikey”) .Renviron faili.

# Use fa icon
icon_fa_camera <- makeAwesomeIcon(icon = 'camera', 
                           markerColor = 'red',
                           library='fa',
                           iconColor = 'black')
# Plotting function
#' @param gpx character string, either gpx xml or gpx file name.
plot_trip2 <- function(gpx, trip = NULL, popupdata = NULL){
  
  # Thunderforest base url
  thunderforest_link_template <- "https://{s}.tile.thunderforest.com/%s/{z}/{x}/{y}.png?apikey=%s"
  
  # Munge gpx data for boundingbox and plotting
  if(str_detect(gpx, "^\\<\\?xml")){
    # Select only first two cols to keep numeric
    bb <- xml2::as_xml_document(gpx) %>% 
      xml2::xml_ns_strip() %>% 
      xml2::xml_find_all("metadata/bounds") %>% 
      xml2::xml_attrs() %>% 
      unlist %>%
      vapply(as.numeric, numeric(1))
  } else {
    # if filename is argument
    bb <- rgdal::readOGR(gpx, layer = "tracks", verbose = FALSE)
    bb <- sp::bbox(bb)
    gpx <- readr::read_file(gpx)
  }
  
  # Compose map
  m <- leaflet() %>%
    
    # Zoom map to your data
    fitBounds(lng1 = bb[[2]], lat1 = bb[[1]], lng2 = bb[[4]], lat2 = bb[[3]]) %>%
    
    # Add tiles
    addTiles(sprintf(thunderforest_link_template, "landscape", Sys.getenv("THUNDERF_APIKEY")), group = "Topograafiline") %>%
    addTiles(sprintf(thunderforest_link_template, "cycle", Sys.getenv("THUNDERF_APIKEY")), group = "Rattateed") %>%
    addTiles(sprintf(thunderforest_link_template, "outdoors", Sys.getenv("THUNDERF_APIKEY")), group = "Matka- ja terviserajad") %>%
    addProviderTiles("Stamen.Terrain", group = "Pinnavormid", options = providerTileOptions(detectRetina = T)) %>%
    addProviderTiles("OpenStreetMap.Mapnik", group = "Sõiduteed", options = providerTileOptions(detectRetina = T)) %>%
    addProviderTiles("Esri.WorldImagery", group = "Satelliit", options = providerTileOptions(detectRetina = T))
  
  # Add data
  elevationPlugin <- htmlDependency("Leaflet.elevation", "0.0.4",
                                    src = normalizePath("inst/htmlwidgets/lib/elevation/"),
                                    script = "leaflet.elevation-0.0.4.src.js",
                                    stylesheet = "leaflet.elevation-0.0.4.css")
  
  gpxPlugin <- htmlDependency("leaflet-gpx", "0.0.1",
                              src = normalizePath("inst/htmlwidgets/lib/gpx/"),
                              script = "gpx.js")
  
  # A function that takes a plugin htmlDependency object and adds
  # it to the map. This ensures that however or whenever the map
  # gets rendered, the plugin will be loaded into the browser.
  registerPlugin <- function(map, plugin) {
    map$dependencies <- c(map$dependencies, list(plugin))
    map
  }
  
  m <- m %>%
    # Register plugins on this map instance
    registerPlugin(gpxPlugin) %>%
    registerPlugin(elevationPlugin) %>%
    # Add your custom JS logic here. The `this` keyword
    # refers to the Leaflet (JS) map object.
    onRender("function(el, x, data) {

          var elev = L.control.elevation({
              theme: 'lime-theme',
              width: 300,
              useHeightIndicator: true // position marker is shown only on first map if true
          });
              elev.addTo(this);

          var g = new L.GPX(data, 
            {async: true,
             marker_options: {
        startIconUrl: '',
        endIconUrl: '',
        shadowUrl: ''}
           });
          
           g.on('addline', function(e){
             elev.addData(e.line);
           });
           
           g.addTo(this);

}", data = gpx)
  
  # Add legend
  if(!is.null(trip)){
    m <- m %>% addLegend(position = 'bottomright', 
                         opacity = 0.4, 
                         colors = 'blue', 
                         labels = trip,
                         title = 'Norra 2017')}
  
  # Add photo markers
  if(!is.null(popupdata)){
    m <- m %>% addAwesomeMarkers(lng = popupdata$lon,
                                 lat = popupdata$lat,
                                 popup = popupdata$popup,
                                 popupOptions = popupOptions(closeButton = TRUE, 
                                                             maxWidth = 500,
                                                             closeOnClick = TRUE),
                                 icon = icon_fa_camera,
                                 group = 'Fotod')
  }
  
  # Layers control
  m %>% addLayersControl(position = 'bottomright',
                         baseGroups = c("Topograafiline", 
                                        "Sõiduteed", 
                                        "Rattateed", 
                                        "Matka- ja terviserajad",  
                                        "Satelliit", 
                                        "Pinnavormid"),
                         # overlayGroups = c("Rattamarsruut", "Fotod"),
                         options = layersControlOptions(collapsed = TRUE)) %>%
    
    # Add a fullscreen control button
    addFullscreenControl()
}

Iga päeva distantsi kanname eraldi kaartile, lisame legendi ja fotod, kui need on olemas.

tracks <- mutate(tracks, trip_leaf = pmap(list(gpxstring, trip, popupdata), plot_trip2))

Üksikuid kaarte näeb tracks data_frame-st niimoodi, tuleb valida trip_leaf list/tulp ja sealt subsettida:

tracks$trip_leaf[[1]]

Erinevaid aluskaarte saab valida alt paremast nurgast (legendi kohal), kursoriga aktiveeritavast menüüst.

K, 12. juuli

Esimesel päeval sai kogemata hullu pandud ja kogu Rallarvägen ühe raksuga läbi sõidetud. Alguses sai suvise aasa servas õlut juua, hiljem tuli ratast läbi lume tassida.

N, 13. juuli

Myrdali ja Utne vahel tuli sõita üks peatus rongiga, läbi tunneli. Rongis on tunnelis sõites pileti ostmine problemaatiline, mistõttu saime lausa tasuta.

R, 14. juuli

Stanghelles oli plaan praamiga teisele kaldale sõita ja rattaga Bergenisse vändata, kuid selle ülesõidu oleks pidanud juba varem kokku leppima/tellima. Seega sõitsime rongiga otse Bergenisse. Ööbisime kloostri taga metsas, suht literaalselt.

L, 15. juuli

Päev algas ekslemise ja sadama otsimisega. Ööbima jäime vihma tõttu ühte pisikesse sadamasse, kõigi mugavustega sadamamajakesse.

P, 16. juuli

Hoogtöö päev. Sai sõidetud 100 km ja üle 1000 m ronitud. Unistasime õllest.

E, 17. juuli

Kõrgel on ilus - ronimise päev. Sai sõidetud pea poole vähem kui eelmisel päeval, kuid see eest rohkem ronida. Trackis on vahepeal katkestus, sest unustasin kella sisse lülitada, olid kõige magusamad ronimispalad.

T, 18. juuli

Allamäge. Päev algas küll korraliku ronimise ja 4+km pikkuse tunneliga, kuid hiljem oli ainult allamäge veeremine. Tundus, et läbisime Norra puuviljakasvatuspiirkonda - kõikjal olid mureli- ja pirniaiad.

K, 19. juuli

Tagasi Vossi rongi peale. Teepeal nägime paari turistilõksu ja peldikut, mis mõjus nagu pühamu.